home *** CD-ROM | disk | FTP | other *** search
/ APDL Eductation Resources / APDL Eductation Resources.iso / programs / misc / sss / !SSS / c / eval < prev    next >
Encoding:
Text File  |  1991-07-30  |  5.4 KB  |  225 lines
  1. /* Parser for SSS */
  2. /* Tue,30 Jul 1991 */
  3. /* Copyright C.T.Stretch 1991 */
  4.  
  5. #include "ssshdr.h"
  6. #include <signal.h>
  7. #include <setjmp.h>
  8. #include <float.h>
  9.  
  10. #define CHK(c) if(*nextc++!=c) longjmp(env,2)
  11. #define DO(f)  CHK('(');val=f(rexp(0));CHK(')');break
  12. #define R(a,b) CHK('[');a=iexp(0);CHK(',');b=iexp(0);CHK(']')
  13. #define DR     R(x0,y0);R(x1,y1)
  14.  
  15. static jmp_buf env;
  16. static double sx,sxx;
  17. static int nx,x0,y0,x1,y1;
  18. int vx,vy;
  19. double value;
  20. char *expr;
  21. BOOL perr;
  22. static char *nextc;
  23.  
  24. static double rexp(int);
  25. static int iexp(int);
  26.  
  27. static double cell(int x,int y)
  28. { entry *cb;
  29.   fixed=0;
  30.   if(x<0 || x>=ncols || y<0 || y>=nrows)
  31.   { errno=1;
  32.     return 1;
  33.   }
  34.   cb=sheet[x+NCOLS*y];
  35.   if(!cb||cb->t<FINT||cb->a||cb->p)
  36.   { errno=1;
  37.     return 1;
  38.   }
  39.   return cb->v;
  40. }
  41.  
  42. static double cmax()
  43. { entry *cb;
  44.   int x,y;
  45.   double best=-DBL_MAX;
  46.   fixed=0;
  47.   if(x0<0 || x1>=ncols || y0<0 || y1>=nrows)
  48.   { errno=1;
  49.     return 0;
  50.   }
  51.   for(x=x0;x<=x1;x++) for(y=y0;y<=y1;y++)
  52.   { cb=sheet[x+NCOLS*y];
  53.     if(cb&&cb->t>=FINT&&!(cb->a||cb->p))
  54.     { if(cb->v>best) best=cb->v;
  55.     }
  56.   }
  57.   if(best==-DBL_MAX) {errno=1;return 0;}
  58.   return best;
  59. }
  60.  
  61. static double cmin()
  62. { entry *cb;
  63.   int x,y;
  64.   double best=DBL_MAX;
  65.   fixed=0;
  66.   if(x0<0 || x1>=ncols || y0<0 || y1>=nrows)
  67.   { errno=1;
  68.     return 0;
  69.   }
  70.   for(x=x0;x<=x1;x++) for(y=y0;y<=y1;y++)
  71.   { cb=sheet[x+NCOLS*y];
  72.     if(cb&&cb->t>=FINT&&!(cb->a||cb->p))
  73.     { if(cb->v<best) best=cb->v;
  74.     }
  75.   }
  76.   if(best==DBL_MAX) {errno=1;return 0;}
  77.   return best;
  78. }
  79.  
  80. static void countup()
  81. { entry *cb;
  82.   int x,y;
  83.   fixed=0;
  84.   nx=0;sx=0;sxx=0;
  85.   if(x0<0 || x1>=ncols || y0<0 || y1>=nrows)
  86.   { errno=1;
  87.     return ;
  88.   }
  89.   for(x=x0;x<=x1;x++) for(y=y0;y<=y1;y++)
  90.   { cb=sheet[x+NCOLS*y];
  91.     if(cb&&cb->t>=FINT&&!(cb->p||cb->a))
  92.     { nx++;sx+=cb->v;sxx+=cb->v*cb->v;
  93.     }
  94.   }
  95.   return ;
  96. }
  97.  
  98. static int ibexp()
  99. { int val;
  100.   switch(*nextc)
  101.   { case '(':nextc++;
  102.              val=iexp(0);
  103.              CHK(')');
  104.              break;
  105.     case '+':nextc++;
  106.              val=iexp(0);
  107.              break;
  108.     case '-':nextc++;
  109.              val=-iexp(0);
  110.              break;
  111.     case 'x':nextc++;val=vx;break;
  112.     case 'y':nextc++;val=vy;break;
  113.      default:if(isdigit(*nextc)) val=(int)strtol(nextc,&nextc,10);
  114.              else longjmp(env,2);
  115.   }
  116.   return val;
  117. }
  118.  
  119. static int iexp(int n)
  120. { int a=ibexp();
  121.   for(;;) switch(*nextc)
  122.   { case '+':if(n>=1) return a;nextc++;a+=iexp(1);break;
  123.     case '-':if(n>=1) return a;nextc++;a-=iexp(1);break;
  124.     case '*':if(n>=2) return a;nextc++;a*=iexp(2);break;
  125.     case '/':if(n>=2) return a;nextc++;a/=iexp(2);break;
  126.     case ' ':nextc++;break;
  127.     default :return a;
  128.   }
  129. }
  130.  
  131. static double rbexp()
  132. { double val;
  133.   int i;
  134.   switch(*nextc)
  135.   { case '(':nextc++;
  136.              val=rexp(0);
  137.              CHK(')');
  138.              break;
  139.     case '[':nextc++;
  140.              i=iexp(0);
  141.              CHK(',');
  142.              val=cell(i,iexp(0));
  143.              CHK(']');
  144.              break;
  145.     case '+':nextc++;
  146.              val=rexp(0);
  147.              break;
  148.     case '-':nextc++;
  149.              val=-rexp(0);
  150.              break;
  151.     case '.':val=strtod(nextc,&nextc);break;
  152.     default :if(isdigit(*nextc)) { val=strtod(nextc,&nextc);break;}
  153.              switch((int)strtol(nextc,&nextc,36))
  154.              { case    33:val=vx;break;
  155.                case    34:val=vy;break;
  156.                case 36959:DO(sin);
  157.                case 16444:DO(cos);
  158.                case 37967:DO(tan);
  159.                case 28096:DO(log);
  160.                case 19357:DO(exp);
  161.                case 1341065:DO(sqrt);
  162.                case 1034:CHK('(');val=rexp(0);CHK(')');val=val*val;break;
  163.                case 578685:DO(ceil);
  164.                case 26206011:DO(floor);
  165.                case 46509097:CHK('(');val=floor(rexp(0)+0.5);CHK(')');break;
  166.                case 503519:DO(asin);
  167.                case 483004:DO(acos);
  168.                case 504527:DO(atan);
  169.                case 18162974:CHK('(');val=rexp(0);;CHK(',');
  170.                                       val=atan2(val,rexp(0));
  171.                                       CHK('(');break;
  172.                case 1330541:DO(sinh);
  173.                case 592001:DO(cosh);
  174.                case 1366829:DO(tanh);
  175.                case 37390:DR;countup();val=sx;break;
  176.                case 21314873:DR;countup();val=nx;break;
  177.                case 13384:DO(fabs);
  178.                case 1044959:DR;countup();val=sx/nx;break;
  179.                case 37309:DR;countup();
  180.                           val=sqrt((nx*sxx-sx*sx)/(nx*(nx-1)));break;
  181.                case 33421:DR;countup();
  182.                              val=sqrt(sxx-sx*sx/nx);break;
  183.                case   918:val=4*atan(1);break;
  184.                case    14:val=exp(1);break;
  185.                case 28905:DR;val=cmax();break;
  186.                case 29183:DR;val=cmin();break;
  187.                default:longjmp(env,2);
  188.              }
  189.              break;
  190.   }
  191.   return val;
  192. }
  193.  
  194. static double rexp(int n)
  195. { double a=rbexp();
  196.   for(;;) switch(*nextc)
  197.   { case '+':if(n>=1) return a;nextc++;a+=rexp(1);break;
  198.     case '-':if(n>=1) return a;nextc++;a-=rexp(1);break;
  199.     case '*':if(n>=2) return a;nextc++;a*=rexp(2);break;
  200.     case '/':if(n>=2) return a;nextc++;a/=rexp(2);break;
  201.     case '^':if(n>=3) return a;nextc++;a=pow(a,rexp(4));break;
  202.     case ' ':nextc++;break;
  203.     default :return a;
  204.   }
  205. }
  206.  
  207. static void badfpe(int snag)
  208. { if(snag==SIGFPE) longjmp(env,1);
  209. }
  210.  
  211. void eval()
  212. { int e;
  213.   nextc=expr;
  214.   errno=0;
  215.   fixed=1;
  216.   if(e=setjmp(env))
  217.   { if(e==1) { errno=1;perr=0;} else perr=1;
  218.     fixed=0;return;
  219.   }
  220.   signal(SIGFPE,badfpe);
  221.   value=rexp(0);
  222.   perr=*nextc;
  223.   signal(SIGFPE,SIG_DFL);
  224. }
  225.